home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / listbox.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  44.3 KB  |  1,415 lines  |  [TEXT/ALFA]
  1. # This file is a Tcl script to test out the "listbox" command
  2. # of Tk.  It is organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1993-1994 The Regents of the University of California.
  5. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10. # SCCS: @(#) listbox.test 1.42 97/07/31 10:00:38
  11.  
  12. if {[string compare test [info procs test]] == 1} then \
  13.   {source defs}
  14.  
  15. foreach i [winfo children .] {
  16.     destroy $i
  17. }
  18. wm geometry . {}
  19. raise .
  20. set fixed {Courier -12}
  21.  
  22. proc record args {
  23.     global log
  24.     lappend log $args
  25. }
  26.  
  27. proc getsize w {
  28.     regexp {(^[^+-]*)} [wm geometry $w] foo x
  29.     return $x
  30. }
  31.  
  32. proc resetGridInfo {} {
  33.     # Some window managers, such as mwm, don't reset gridding information
  34.     # unless the window is withdrawn and re-mapped.  If this procedure
  35.     # isn't invoked, the window manager will stay in gridded mode, which
  36.     # can cause all sorts of problems.  The "wm positionfrom" command is
  37.     # needed so that the window manager doesn't ask the user to
  38.     # manually position the window when it is re-mapped.
  39.  
  40.     wm withdraw .
  41.     wm positionfrom . user
  42.     wm deiconify .
  43. }
  44.  
  45. # Procedure that creates a second listbox for checking things related
  46. # to partially visible lines.
  47.  
  48. proc mkPartial {{w .partial}} {
  49.     catch {destroy $w}
  50.     toplevel $w
  51.     wm geometry $w +0+0
  52.     listbox $w.l -width 30 -height 5
  53.     pack $w.l -expand 1 -fill both
  54.     $w.l insert end one two three four five six seven eight nine ten \
  55.         eleven twelve thirteen fourteen fifteen
  56.     update
  57.     scan [wm geometry $w] "%dx%d" width height
  58.     wm geometry $w ${width}x[expr $height-3]
  59.     update
  60. }
  61.  
  62. # Create entries in the option database to be sure that geometry options
  63. # like border width have predictable values.
  64.  
  65. option add *Listbox.borderWidth 2
  66. option add *Listbox.highlightThickness 2
  67. option add *Listbox.font {Helvetica -12 bold}
  68.  
  69. listbox .l
  70. pack .l
  71. update
  72. resetGridInfo
  73. set i 1
  74.  
  75. foreach test {
  76.     {-background #ff0000 #ff0000 non-existent
  77.         {unknown color name "non-existent"}}
  78.     {-bd 4 4 badValue {bad screen distance "badValue"}}
  79.     {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
  80.     {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  81.     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
  82.     {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}}
  83.     {-fg #110022 #110022 bogus {unknown color name "bogus"}}
  84.     {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}}
  85.     {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
  86.     {-height 30 30 20p {expected integer but got "20p"}}
  87.     {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
  88.     {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
  89.     {-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
  90.     {-highlightthickness -2 0 {} {}}
  91.     {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
  92.     {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
  93.     {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  94.     {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
  95.     {-selectmode string string {} {}}
  96.     {-setgrid false 0 lousy {expected boolean value but got "lousy"}}
  97.     {-takefocus "any string" "any string" {} {}}
  98.     {-width 45 45 3p {expected integer but got "3p"}}
  99.     {-xscrollcommand {Some command} {Some command} {} {}}
  100.     {-yscrollcommand {Another command} {Another command} {} {}}
  101. } {
  102.     set name [lindex $test 0]
  103.     test listbox-1.$i {configuration options} {
  104.     .l configure $name [lindex $test 1]
  105.     list [lindex [.l configure $name] 4] [.l cget $name]
  106.     } [list [lindex $test 2] [lindex $test 2]]
  107.     incr i
  108.     if {[lindex $test 3] != ""} {
  109.     test listbox-1.$i {configuration options} {
  110.         list [catch {.l configure $name [lindex $test 3]} msg] $msg
  111.     } [list 1 [lindex $test 4]]
  112.     }
  113.     .l configure $name [lindex [.l configure $name] 3]
  114.     incr i
  115. }
  116.  
  117. test listbox-2.1 {Tk_ListboxCmd procedure} {
  118.     list [catch {listbox} msg] $msg
  119. } {1 {wrong # args: should be "listbox pathName ?options?"}}
  120. test listbox-2.2 {Tk_ListboxCmd procedure} {
  121.     list [catch {listbox gorp} msg] $msg
  122. } {1 {bad window path name "gorp"}}
  123. test listbox-2.3 {Tk_ListboxCmd procedure} {
  124.     catch {destroy .l}
  125.     listbox .l
  126.     list [winfo exists .l] [winfo class .l] [info commands .l]
  127. } {1 Listbox .l}
  128. test listbox-2.4 {Tk_ListboxCmd procedure} {
  129.     catch {destroy .l}
  130.     list [catch {listbox .l -gorp foo} msg] $msg [winfo exists .l] \
  131.         [info commands .l]
  132. } {1 {unknown option "-gorp"} 0 {}}
  133. test listbox-2.5 {Tk_ListboxCmd procedure} {
  134.     catch {destroy .l}
  135.     listbox .l
  136. } {.l}
  137.  
  138. catch {destroy .l}
  139. listbox .l -width 20 -height 5 -bd 4 -highlightthickness 1 -selectborderwidth 2
  140. pack .l
  141. .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 el12 el13 el14 \
  142.     el15 el16 el17
  143. update
  144. test listbox-3.1 {ListboxWidgetCmd procedure} {
  145.     list [catch .l msg] $msg
  146. } {1 {wrong # args: should be ".l option ?arg arg ...?"}}
  147. test listbox-3.2 {ListboxWidgetCmd procedure, "activate" option} {
  148.     list [catch {.l activate} msg] $msg
  149. } {1 {wrong # args: should be ".l activate index"}}
  150. test listbox-3.3 {ListboxWidgetCmd procedure, "activate" option} {
  151.     list [catch {.l activate a b} msg] $msg
  152. } {1 {wrong # args: should be ".l activate index"}}
  153. test listbox-3.4 {ListboxWidgetCmd procedure, "activate" option} {
  154.     list [catch {.l activate fooey} msg] $msg
  155. } {1 {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number}}
  156. test listbox-3.5 {ListboxWidgetCmd procedure, "activate" option} {
  157.     .l activate 3
  158.     .l index active
  159. } 3
  160. test listbox-3.6 {ListboxWidgetCmd procedure, "bbox" option} {
  161.     list [catch {.l bbox} msg] $msg
  162. } {1 {wrong # args: should be ".l bbox index"}}
  163. test listbox-3.7 {ListboxWidgetCmd procedure, "bbox" option} {
  164.     list [catch {.l bbox a b} msg] $msg
  165. } {1 {wrong # args: should be ".l bbox index"}}
  166. test listbox-3.8 {ListboxWidgetCmd procedure, "bbox" option} {
  167.     list [catch {.l bbox fooey} msg] $msg
  168. } {1 {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number}}
  169. test listbox-3.9 {ListboxWidgetCmd procedure, "bbox" option} {
  170.     .l yview 3
  171.     update
  172.     list [.l bbox 2] [.l bbox 8]
  173. } {{} {}}
  174. test listbox-3.10 {ListboxWidgetCmd procedure, "bbox" option} {
  175.     # Used to generate a core dump before a bug was fixed (the last
  176.     # element would be on-screen if it existed, but it doesn't exist).
  177.  
  178.     listbox .l2
  179.     pack .l2 -side top
  180.     tkwait visibility .l2
  181.     set x [.l2 bbox 0]
  182.     destroy .l2
  183.     set x
  184. } {}
  185. test listbox-3.11 {ListboxWidgetCmd procedure, "bbox" option} {fonts} {
  186.     .l yview 3
  187.     update
  188.     list [.l bbox 3] [.l bbox 4]
  189. } {{7 7 17 14} {7 26 17 14}}
  190. test listbox-3.12 {ListboxWidgetCmd procedure, "bbox" option} {fonts} {
  191.     catch {destroy .t}
  192.     toplevel .t
  193.     wm geom .t +0+0
  194.     listbox .t.l -width 10 -height 5
  195.     .t.l insert 0 "Short" "Somewhat longer" "Really, quite a whole lot longer than can possibly fit on the screen" "Short"
  196.     pack .t.l
  197.     update
  198.     .t.l xview moveto .2
  199.     .t.l bbox 2
  200. } {-72 39 393 14}
  201. test listbox-3.13 {ListboxWidgetCmd procedure, "bbox" option, partial last line} {fonts} {
  202.     mkPartial
  203.     list [.partial.l bbox 3] [.partial.l bbox 4]
  204. } {{5 56 24 14} {5 73 23 14}}
  205. test listbox-3.14 {ListboxWidgetCmd procedure, "cget" option} {
  206.     list [catch {.l cget} msg] $msg
  207. } {1 {wrong # args: should be ".l cget option"}}
  208. test listbox-3.15 {ListboxWidgetCmd procedure, "cget" option} {
  209.     list [catch {.l cget a b} msg] $msg
  210. } {1 {wrong # args: should be ".l cget option"}}
  211. test listbox-3.16 {ListboxWidgetCmd procedure, "cget" option} {
  212.     list [catch {.l cget -gorp} msg] $msg
  213. } {1 {unknown option "-gorp"}}
  214. test listbox-3.17 {ListboxWidgetCmd procedure, "cget" option} {
  215.     .l cget -setgrid
  216. } {0}
  217. test listbox-3.18 {ListboxWidgetCmd procedure, "configure" option} {
  218.     llength [.l configure]
  219. } {23}
  220. test listbox-3.19 {ListboxWidgetCmd procedure, "configure" option} {
  221.     list [catch {.l configure -gorp} msg] $msg
  222. } {1 {unknown option "-gorp"}}
  223. test listbox-3.20 {ListboxWidgetCmd procedure, "configure" option} {
  224.     .l configure -setgrid
  225. } {-setgrid setGrid SetGrid 0 0}
  226. test listbox-3.21 {ListboxWidgetCmd procedure, "configure" option} {
  227.     list [catch {.l configure -gorp is_messy} msg] $msg
  228. } {1 {unknown option "-gorp"}}
  229. test listbox-3.22 {ListboxWidgetCmd procedure, "configure" option} {
  230.     set oldbd [.l cget -bd]
  231.     set oldht [.l cget -highlightthickness]
  232.     .l configure -bd 3 -highlightthickness 0
  233.     set x "[.l cget -bd] [.l cget -highlightthickness]"
  234.     .l configure -bd $oldbd -highlightthickness $oldht
  235.     set x
  236. } {3 0}
  237. test listbox-3.23 {ListboxWidgetCmd procedure, "curselection" option} {
  238.     list [catch {.l curselection a} msg] $msg
  239. } {1 {wrong # args: should be ".l curselection"}}
  240. test listbox-3.24 {ListboxWidgetCmd procedure, "curselection" option} {
  241.     .l selection clear 0 end
  242.     .l selection set 3 6
  243.     .l selection set 9
  244.     .l curselection
  245. } {3 4 5 6 9}
  246. test listbox-3.25 {ListboxWidgetCmd procedure, "delete" option} {
  247.     list [catch {.l delete} msg] $msg
  248. } {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}}
  249. test listbox-3.26 {ListboxWidgetCmd procedure, "delete" option} {
  250.     list [catch {.l delete a b c} msg] $msg
  251. } {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}}
  252. test listbox-3.27 {ListboxWidgetCmd procedure, "delete" option} {
  253.     list [catch {.l delete badIndex} msg] $msg
  254. } {1 {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number}}
  255. test listbox-3.28 {ListboxWidgetCmd procedure, "delete" option} {
  256.     list [catch {.l delete 2 123ab} msg] $msg
  257. } {1 {bad listbox index "123ab": must be active, anchor, end, @x,y, or a number}}
  258. test listbox-3.29 {ListboxWidgetCmd procedure, "delete" option} {
  259.     catch {destroy .l2}
  260.     listbox .l2
  261.     .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
  262.     .l2 delete 3
  263.     list [.l2 get 2] [.l2 get 3] [.l2 index end]
  264. } {el2 el4 7}
  265. test listbox-3.30 {ListboxWidgetCmd procedure, "delete" option} {
  266.     catch {destroy .l2}
  267.     listbox .l2
  268.     .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
  269.     .l2 delete 2 4
  270.     list [.l2 get 1] [.l2 get 2] [.l2 index end]
  271. } {el1 el5 5}
  272. test listbox-3.31 {ListboxWidgetCmd procedure, "get" option} {
  273.     list [catch {.l get} msg] $msg
  274. } {1 {wrong # args: should be ".l get first ?last?"}}
  275. test listbox-3.32 {ListboxWidgetCmd procedure, "get" option} {
  276.     list [catch {.l get a b c} msg] $msg
  277. } {1 {wrong # args: should be ".l get first ?last?"}}
  278. test listbox-3.33 {ListboxWidgetCmd procedure, "get" option} {
  279.     list [catch {.l get 2.4} msg] $msg
  280. } {1 {bad listbox index "2.4": must be active, anchor, end, @x,y, or a number}}
  281. test listbox-3.34 {ListboxWidgetCmd procedure, "get" option} {
  282.     list [catch {.l get end bogus} msg] $msg
  283. } {1 {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number}}
  284. test listbox-3.35 {ListboxWidgetCmd procedure, "get" option} {
  285.     catch {destroy .l2}
  286.     listbox .l2
  287.     .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
  288.     list [.l2 get 0] [.l2 get 3] [.l2 get end]
  289. } {el0 el3 el7}
  290. test listbox-3.36 {ListboxWidgetCmd procedure, "get" option} {
  291.     catch {destroy .l2}
  292.     listbox .l2
  293.     list [.l2 get 0] [.l2 get end]
  294. } {{} {}}
  295. test listbox-3.37 {ListboxWidgetCmd procedure, "get" option} {
  296.     catch {destroy .l2}
  297.     listbox .l2
  298.     .l2 insert 0 el0 el1 el2 "two words" el4 el5 el6 el7
  299.     .l2 get 3 end
  300. } {{two words} el4 el5 el6 el7}
  301. test listbox-3.38 {ListboxWidgetCmd procedure, "index" option} {
  302.     list [catch {.l index} msg] $msg
  303. } {1 {wrong # args: should be ".l index index"}}
  304. test listbox-3.39 {ListboxWidgetCmd procedure, "index" option} {
  305.     list [catch {.l index a b} msg] $msg
  306. } {1 {wrong # args: should be ".l index index"}}
  307. test listbox-3.40 {ListboxWidgetCmd procedure, "index" option} {
  308.     list [catch {.l index @} msg] $msg
  309. } {1 {bad listbox index "@": must be active, anchor, end, @x,y, or a number}}
  310. test listbox-3.41 {ListboxWidgetCmd procedure, "index" option} {
  311.     .l index 2
  312. } 2
  313. test listbox-3.42 {ListboxWidgetCmd procedure, "insert" option} {
  314.     list [catch {.l insert} msg] $msg
  315. } {1 {wrong # args: should be ".l insert index ?element element ...?"}}
  316. test listbox-3.43 {ListboxWidgetCmd procedure, "insert" option} {
  317.     list [catch {.l insert badIndex} msg] $msg
  318. } {1 {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number}}
  319. test listbox-3.44 {ListboxWidgetCmd procedure, "insert" option} {
  320.     catch {destroy .l2}
  321.     listbox .l2
  322.     .l2 insert end a b c d e
  323.     .l2 insert 3 x y z
  324.     .l2 get 0 end
  325. } {a b c x y z d e}
  326. test listbox-3.45 {ListboxWidgetCmd procedure, "nearest" option} {
  327.     list [catch {.l nearest} msg] $msg
  328. } {1 {wrong # args: should be ".l nearest y"}}
  329. test listbox-3.46 {ListboxWidgetCmd procedure, "nearest" option} {
  330.     list [catch {.l nearest a b} msg] $msg
  331. } {1 {wrong # args: should be ".l nearest y"}}
  332. test listbox-3.47 {ListboxWidgetCmd procedure, "nearest" option} {
  333.     list [catch {.l nearest 20p} msg] $msg
  334. } {1 {expected integer but got "20p"}}
  335. test listbox-3.48 {ListboxWidgetCmd procedure, "nearest" option} {
  336.     .l nearest 1000
  337. } {7}
  338. test listbox-3.49 {ListboxWidgetCmd procedure, "scan" option} {
  339.     list [catch {.l scan a b} msg] $msg
  340. } {1 {wrong # args: should be ".l scan mark|dragto x y"}}
  341. test listbox-3.50 {ListboxWidgetCmd procedure, "scan" option} {
  342.     list [catch {.l scan a b c d} msg] $msg
  343. } {1 {wrong # args: should be ".l scan mark|dragto x y"}}
  344. test listbox-3.51 {ListboxWidgetCmd procedure, "scan" option} {
  345.     list [catch {.l scan foo bogus 2} msg] $msg
  346. } {1 {expected integer but got "bogus"}}
  347. test listbox-3.52 {ListboxWidgetCmd procedure, "scan" option} {
  348.     list [catch {.l scan foo 2 2.3} msg] $msg
  349. } {1 {expected integer but got "2.3"}}
  350. test listbox-3.53 {ListboxWidgetCmd procedure, "scan" option} {fonts} {
  351.     catch {destroy .t}
  352.     toplevel .t
  353.     wm geom .t +0+0
  354.     listbox .t.l -width 10 -height 5
  355.     .t.l insert 0 "Short" "Somewhat longer" "Really, quite a whole lot longer than can possibly fit on the screen" "Short" a b c d e f g h i j
  356.     pack .t.l
  357.     update
  358.     .t.l scan mark 100 140
  359.     .t.l scan dragto 90 137
  360.     update
  361.     list [.t.l xview] [.t.l yview]
  362. } {{0.249364 0.427481} {0.0714286 0.428571}}
  363. test listbox-3.54 {ListboxWidgetCmd procedure, "scan" option} {
  364.     list [catch {.l scan foo 2 4} msg] $msg
  365. } {1 {bad scan option "foo": must be mark or dragto}}
  366. test listbox-3.55 {ListboxWidgetCmd procedure, "see" option} {
  367.     list [catch {.l see} msg] $msg
  368. } {1 {wrong # args: should be ".l see index"}}
  369. test listbox-3.56 {ListboxWidgetCmd procedure, "see" option} {
  370.     list [catch {.l see a b} msg] $msg
  371. } {1 {wrong # args: should be ".l see index"}}
  372. test listbox-3.57 {ListboxWidgetCmd procedure, "see" option} {
  373.     list [catch {.l see gorp} msg] $msg
  374. } {1 {bad listbox index "gorp": must be active, anchor, end, @x,y, or a number}}
  375. test listbox-3.58 {ListboxWidgetCmd procedure, "see" option} {
  376.     .l yview 7
  377.     .l see 7
  378.     .l index @0,0
  379. } {7}
  380. test listbox-3.59 {ListboxWidgetCmd procedure, "see" option} {
  381.     .l yview 7
  382.     .l see 11
  383.     .l index @0,0
  384. } {7}
  385. test listbox-3.60 {ListboxWidgetCmd procedure, "see" option} {
  386.     .l yview 7
  387.     .l see 6
  388.     .l index @0,0
  389. } {6}
  390. test listbox-3.61 {ListboxWidgetCmd procedure, "see" option} {
  391.     .l yview 7
  392.     .l see 5
  393.     .l index @0,0
  394. } {3}
  395. test listbox-3.62 {ListboxWidgetCmd procedure, "see" option} {
  396.     .l yview 7
  397.     .l see 12
  398.     .l index @0,0
  399. } {8}
  400. test listbox-3.63 {ListboxWidgetCmd procedure, "see" option} {
  401.     .l yview 7
  402.     .l see 13
  403.     .l index @0,0
  404. } {11}
  405. test listbox-3.64 {ListboxWidgetCmd procedure, "see" option, partial last line} {
  406.     mkPartial
  407.     .partial.l see 4
  408.     .partial.l index @0,0
  409. } {1}
  410. test listbox-3.65 {ListboxWidgetCmd procedure, "selection" option} {
  411.     list [catch {.l select a} msg] $msg
  412. } {1 {wrong # args: should be ".l selection option index ?index?"}}
  413. test listbox-3.66 {ListboxWidgetCmd procedure, "selection" option} {
  414.     list [catch {.l select a b c d} msg] $msg
  415. } {1 {wrong # args: should be ".l selection option index ?index?"}}
  416. test listbox-3.67 {ListboxWidgetCmd procedure, "selection" option} {
  417.     list [catch {.l selection a bogus} msg] $msg
  418. } {1 {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number}}
  419. test listbox-3.68 {ListboxWidgetCmd procedure, "selection" option} {
  420.     list [catch {.l selection a 0 lousy} msg] $msg
  421. } {1 {bad listbox index "lousy": must be active, anchor, end, @x,y, or a number}}
  422. test listbox-3.69 {ListboxWidgetCmd procedure, "selection" option} {
  423.     list [catch {.l selection anchor 0 0} msg] $msg
  424. } {1 {wrong # args: should be ".l selection anchor index"}}
  425. test listbox-3.70 {ListboxWidgetCmd procedure, "selection" option} {
  426.     list [.l selection anchor 5; .l index anchor] \
  427.         [.l selection anchor 0; .l index anchor]
  428. } {5 0}
  429. test listbox-3.71 {ListboxWidgetCmd procedure, "selection" option} {
  430.     .l selection clear 0 end
  431.     .l selection set 2 8
  432.     .l selection clear 3 4
  433.     .l curselection
  434. } {2 5 6 7 8}
  435. test listbox-3.72 {ListboxWidgetCmd procedure, "selection" option} {
  436.     list [catch {.l selection includes 0 0} msg] $msg
  437. } {1 {wrong # args: should be ".l selection includes index"}}
  438. test listbox-3.73 {ListboxWidgetCmd procedure, "selection" option} {
  439.     .l selection clear 0 end
  440.     .l selection set 2 8
  441.     .l selection clear 4
  442.     list [.l selection includes 3] [.l selection includes 4] \
  443.         [.l selection includes 5]
  444. } {1 0 1}
  445. test listbox-3.74 {ListboxWidgetCmd procedure, "selection" option} {
  446.     catch {destroy .l2}
  447.     listbox .l2
  448.     .l2 selection includes 0
  449. } {0}
  450. test listbox-3.75 {ListboxWidgetCmd procedure, "selection" option} {
  451.     .l selection clear 0 end
  452.     .l selection set 2
  453.     .l selection set 5 7
  454.     .l curselection
  455. } {2 5 6 7}
  456. test listbox-3.76 {ListboxWidgetCmd procedure, "selection" option} {
  457.     list [catch {.l selection badOption 0 0} msg] $msg
  458. } {1 {bad selection option "badOption": must be anchor, clear, includes, or set}}
  459. test listbox-3.77 {ListboxWidgetCmd procedure, "size" option} {
  460.     list [catch {.l size a} msg] $msg
  461. } {1 {wrong # args: should be ".l size"}}
  462. test listbox-3.78 {ListboxWidgetCmd procedure, "size" option} {
  463.     .l size
  464. } {18}
  465. test listbox-3.79 {ListboxWidgetCmd procedure, "xview" option} {
  466.     catch {destroy .l2}
  467.     listbox .l2
  468.     update
  469.     .l2 xview
  470. } {0 1}
  471. test listbox-3.80 {ListboxWidgetCmd procedure, "xview" option} {
  472.     catch {destroy .l}
  473.     listbox .l -width 10 -height 5 -font $fixed
  474.     .l insert 0 a b c d e f g h i j k l m n o p q r s t
  475.     pack .l
  476.     update
  477.     .l xview
  478. } {0 1}
  479. catch {destroy .l}
  480. listbox .l -width 10 -height 5 -font $fixed
  481. .l insert 0 a b c d e f g h i j k l m n o p q r s t
  482. .l insert 1 "0123456789a123456789b123456789c123456789d123456789"
  483. pack .l
  484. update
  485. test listbox-3.81 {ListboxWidgetCmd procedure, "xview" option} {fonts} {
  486.     .l xview 4
  487.     .l xview
  488. } {0.08 0.28}
  489. test listbox-3.82 {ListboxWidgetCmd procedure, "xview" option} {
  490.     list [catch {.l xview foo} msg] $msg
  491. } {1 {expected integer but got "foo"}}
  492. test listbox-3.83 {ListboxWidgetCmd procedure, "xview" option} {
  493.     list [catch {.l xview zoom a b} msg] $msg
  494. } {1 {unknown option "zoom": must be moveto or scroll}}
  495. test listbox-3.84 {ListboxWidgetCmd procedure, "xview" option} {fonts} {
  496.     .l xview 0
  497.     .l xview moveto .4
  498.     update
  499.     .l xview
  500. } {0.4 0.6}
  501. test listbox-3.85 {ListboxWidgetCmd procedure, "xview" option} {fonts} {
  502.     .l xview 0
  503.     .l xview scroll 2 units
  504.     update
  505.     .l xview
  506. } {0.04 0.24}
  507. test listbox-3.86 {ListboxWidgetCmd procedure, "xview" option} {fonts} {
  508.     .l xview 30
  509.     .l xview scroll -1 pages
  510.     update
  511.     .l xview
  512. } {0.44 0.64}
  513. test listbox-3.87 {ListboxWidgetCmd procedure, "xview" option} {fonts} {
  514.     .l configure -width 1
  515.     update
  516.     .l xview 30
  517.     .l xview scroll -4 pages
  518.     update
  519.     .l xview
  520. } {0.52 0.54}
  521. test listbox-3.88 {ListboxWidgetCmd procedure, "yview" option} {
  522.     catch {destroy .l}
  523.     listbox .l
  524.     pack  .l
  525.     update
  526.     .l yview
  527. } {0 1}
  528. test listbox-3.89 {ListboxWidgetCmd procedure, "yview" option} {
  529.     catch {destroy .l}
  530.     listbox .l
  531.     .l insert 0 el1
  532.     pack  .l
  533.     update
  534.     .l yview
  535. } {0 1}
  536. catch {destroy .l}
  537. listbox .l -width 10 -height 5 -font $fixed
  538. .l insert 0 a b c d e f g h i j k l m n o p q r s t
  539. pack .l
  540. update
  541. test listbox-3.90 {ListboxWidgetCmd procedure, "yview" option} {
  542.     .l yview 4
  543.     update
  544.     .l yview
  545. } {0.2 0.45}
  546. test listbox-3.91 {ListboxWidgetCmd procedure, "yview" option, partial last line} {
  547.     mkPartial
  548.     .partial.l yview
  549. } {0 0.266667}
  550. test listbox-3.92 {ListboxWidgetCmd procedure, "xview" option} {
  551.     list [catch {.l yview foo} msg] $msg
  552. } {1 {bad listbox index "foo": must be active, anchor, end, @x,y, or a number}}
  553. test listbox-3.93 {ListboxWidgetCmd procedure, "xview" option} {
  554.     list [catch {.l yview foo a b} msg] $msg
  555. } {1 {unknown option "foo": must be moveto or scroll}}
  556. test listbox-3.94 {ListboxWidgetCmd procedure, "xview" option} {
  557.     .l yview 0
  558.     .l yview moveto .31
  559.     .l yview
  560. } {0.3 0.55}
  561. test listbox-3.95 {ListboxWidgetCmd procedure, "xview" option} {
  562.     .l yview 2
  563.     .l yview scroll 2 pages
  564.     .l yview
  565. } {0.4 0.65}
  566. test listbox-3.96 {ListboxWidgetCmd procedure, "xview" option} {
  567.     .l yview 10
  568.     .l yview scroll -3 units
  569.     .l yview
  570. } {0.35 0.6}
  571. test listbox-3.97 {ListboxWidgetCmd procedure, "xview" option} {
  572.     .l configure -height 2
  573.     update
  574.     .l yview 15
  575.     .l yview scroll -4 pages
  576.     .l yview
  577. } {0.55 0.65}
  578. test listbox-3.98 {ListboxWidgetCmd procedure, "xview" option} {
  579.     list [catch {.l whoknows} msg] $msg
  580. } {1 {bad option "whoknows": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
  581. test listbox-3.99 {ListboxWidgetCmd procedure, "xview" option} {
  582.     list [catch {.l c} msg] $msg
  583. } {1 {bad option "c": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
  584. test listbox-3.100 {ListboxWidgetCmd procedure, "xview" option} {
  585.     list [catch {.l in} msg] $msg
  586. } {1 {bad option "in": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
  587. test listbox-3.101 {ListboxWidgetCmd procedure, "xview" option} {
  588.     list [catch {.l s} msg] $msg
  589. } {1 {bad option "s": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
  590. test listbox-3.102 {ListboxWidgetCmd procedure, "xview" option} {
  591.     list [catch {.l se} msg] $msg
  592. } {1 {bad option "se": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
  593.  
  594. # No tests for DestroyListbox:  I can't come up with anything to test
  595. # in this procedure.
  596.  
  597. test listbox-4.1 {ConfigureListbox procedure} {fonts} {
  598.     catch {destroy .l}
  599.     listbox .l -setgrid 1 -width 25 -height 15
  600.     pack .l
  601.     update
  602.     set x [getsize .]
  603.     .l configure -setgrid 0
  604.     update
  605.     list $x [getsize .]
  606. } {25x15 185x263}
  607. resetGridInfo
  608. test listbox-4.2 {ConfigureListbox procedure} {
  609.     .l configure -highlightthickness -3
  610.     .l cget -highlightthickness
  611. } {0}
  612. test listbox-4.3 {ConfigureListbox procedure} {
  613.     .l configure -exportselection 0
  614.     .l delete 0 end
  615.     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8
  616.     .l selection set 3 5
  617.     .l configure -exportselection 1
  618.     selection get
  619. } {el3
  620. el4
  621. el5}
  622. test listbox-4.4 {ConfigureListbox procedure} {
  623.     catch {destroy .e}
  624.     entry .e
  625.     .e insert 0 abc
  626.     .e select from 0
  627.     .e select to 2
  628.     .l configure -exportselection 0
  629.     .l delete 0 end
  630.     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8
  631.     .l selection set 3 5
  632.     .l selection clear 3 5
  633.     .l configure -exportselection 1
  634.     list [selection own] [selection get]
  635. } {.e ab}
  636. test listbox-4.5 {-exportselection option} {
  637.     selection clear .
  638.     .l configure -exportselection 1
  639.     .l delete 0 end
  640.     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8
  641.     .l selection set 1 1
  642.     set x {}
  643.     lappend x [catch {selection get} msg] $msg [.l curselection]
  644.     .l config -exportselection 0
  645.     lappend x [catch {selection get} msg] $msg [.l curselection]
  646.     .l selection clear 0 end
  647.     lappend x [catch {selection get} msg] $msg [.l curselection]
  648.     .l selection set 1 3
  649.     lappend x [catch {selection get} msg] $msg [.l curselection]
  650.     .l config -exportselection 1
  651.     lappend x [catch {selection get} msg] $msg [.l curselection]
  652. } {0 el1 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {1 2 3} 0 {el1
  653. el2
  654. el3} {1 2 3}}
  655. test listbox-4.6 {ConfigureListbox procedure} {fonts} {
  656.     catch {destroy .l}
  657.  
  658.     # The following code (reset geometry, withdraw, etc.) is necessary
  659.     # to reset the state of some window managers like olvwm under
  660.     # SunOS 4.1.3.
  661.  
  662.     wm geom . 300x300
  663.     update
  664.     wm geom . {}
  665.     wm withdraw .
  666.     listbox .l -font $fixed -width 15 -height 20
  667.     pack .l
  668.     update
  669.     wm deiconify .
  670.     set x [getsize .]
  671.     .l configure -setgrid 1
  672.     update
  673.     list $x [getsize .]
  674. } {115x328 15x20}
  675. test listbox-4.7 {ConfigureListbox procedure} {
  676.     catch {destroy .l}
  677.     wm withdraw .
  678.     listbox .l -font $fixed -width 30 -height 20 -setgrid 1
  679.     wm geom . +0+0
  680.     pack .l
  681.     update
  682.     wm deiconify .
  683.     set result [getsize .]
  684.     wm geom . 26x15
  685.     update
  686.     lappend result [getsize .]
  687.     .l configure -setgrid 1
  688.     update
  689.     lappend result [getsize .]
  690. } {30x20 26x15 26x15}
  691. wm geom . {}
  692. catch {destroy .l}
  693. resetGridInfo
  694. test listbox-4.8 {ConfigureListbox procedure} {
  695.     catch {destroy .l}
  696.     listbox .l -width 15 -height 20 -xscrollcommand "record x" \
  697.         -yscrollcommand "record y"
  698.     pack .l
  699.     update
  700.     .l configure -fg black
  701.     set log {}
  702.     update
  703.     set log
  704. } {{y 0 1} {x 0 1}}
  705.  
  706. # No tests for DisplayListbox:  I don't know how to test this procedure.
  707.  
  708. test listbox-5.1 {ListboxComputeGeometry procedure} {fonts} {
  709.     catch {destroy .l}
  710.     listbox .l -font $fixed -width 15 -height 20
  711.     pack .l
  712.     list [winfo reqwidth .l] [winfo reqheight .l]
  713. } {115 328}
  714. test listbox-5.2 {ListboxComputeGeometry procedure} {fonts} {
  715.     catch {destroy .l}
  716.     listbox .l -font $fixed -width 0 -height 10
  717.     pack .l
  718.     update
  719.     list [winfo reqwidth .l] [winfo reqheight .l]
  720. } {17 168}
  721. test listbox-5.3 {ListboxComputeGeometry procedure} {fonts} {
  722.     catch {destroy .l}
  723.     listbox .l -font $fixed -width 0 -height 10 -bd 3
  724.     .l insert 0 Short "Really much longer" Longer
  725.     pack .l
  726.     update
  727.     list [winfo reqwidth .l] [winfo reqheight .l]
  728. } {138 170}
  729. test listbox-5.4 {ListboxComputeGeometry procedure} {fonts} {
  730.     catch {destroy .l}
  731.     listbox .l -font $fixed -width 10 -height 0
  732.     pack .l
  733.     update
  734.     list [winfo reqwidth .l] [winfo reqheight .l]
  735. } {80 24}
  736. test listbox-5.5 {ListboxComputeGeometry procedure} {fonts} {
  737.     catch {destroy .l}
  738.     listbox .l -font $fixed -width 10 -height 0 -highlightthickness 0
  739.     .l insert 0 Short "Really much longer" Longer
  740.     pack .l
  741.     update
  742.     list [winfo reqwidth .l] [winfo reqheight .l]
  743.     } {76 52}
  744.  
  745. catch {destroy .l}
  746. listbox .l -height 2 -xscrollcommand "record x" -yscrollcommand "record y"
  747. pack .l
  748. update
  749. test listbox-6.1 {InsertEls procedure} {
  750.     .l delete 0 end
  751.     .l insert end a b c d
  752.     .l insert 5 x y z
  753.     .l insert 2 A
  754.     .l insert 0 q r s
  755.     .l get 0 end
  756. } {q r s a b A c d x y z}
  757. test listbox-6.2 {InsertEls procedure} {
  758.     .l delete 0 end
  759.     .l insert 0 a b c d e f g h i j
  760.     .l selection anchor 2
  761.     .l insert 2 A B
  762.     .l index anchor
  763. } {4}
  764. test listbox-6.3 {InsertEls procedure} {
  765.     .l delete 0 end
  766.     .l insert 0 a b c d e f g h i j
  767.     .l selection anchor 2
  768.     .l insert 3 A B
  769.     .l index anchor
  770. } {2}
  771. test listbox-6.4 {InsertEls procedure} {
  772.     .l delete 0 end
  773.     .l insert 0 a b c d e f g h i j
  774.     .l yview 3
  775.     update
  776.     .l insert 2 A B
  777.     .l index @0,0
  778. } {5}
  779. test listbox-6.5 {InsertEls procedure} {
  780.     .l delete 0 end
  781.     .l insert 0 a b c d e f g h i j
  782.     .l yview 3
  783.     update
  784.     .l insert 3 A B
  785.     .l index @0,0
  786. } {3}
  787. test listbox-6.6 {InsertEls procedure} {
  788.     .l delete 0 end
  789.     .l insert 0 a b c d e f g h i j
  790.     .l activate 5
  791.     .l insert 5 A B
  792.     .l index active
  793. } {7}
  794. test listbox-6.7 {InsertEls procedure} {
  795.     .l delete 0 end
  796.     .l insert 0 a b c d e f g h i j
  797.     .l activate 5
  798.     .l insert 6 A B
  799.     .l index active
  800. } {5}
  801. test listbox-6.8 {InsertEls procedure} {
  802.     .l delete 0 end
  803.     .l insert 0 a b c
  804.     .l index active
  805. } {2}
  806. test listbox-6.9 {InsertEls procedure} {
  807.     .l delete 0 end
  808.     .l insert 0
  809.     .l index active
  810. } {0}
  811. test listbox-6.10 {InsertEls procedure} {
  812.     .l delete 0 end
  813.     .l insert 0 a b "two words"  c d e f g h i j
  814.     update
  815.     set log {}
  816.     .l insert 0 word
  817.     update
  818.     set log
  819. } {{y 0 0.166667}}
  820. test listbox-6.11 {InsertEls procedure} {
  821.     .l delete 0 end
  822.     .l insert 0 a b "two words"  c d e f g h i j
  823.     update
  824.     set log {}
  825.     .l insert 0 "much longer entry"
  826.     update
  827.     set log
  828. } {{y 0 0.166667} {x 0 1}}
  829. test listbox-6.12 {InsertEls procedure} {fonts} {
  830.     catch {destroy .l2}
  831.     listbox .l2 -width 0 -height 0
  832.     pack .l2 -side top
  833.     .l2 insert 0 a b "two words"  c d
  834.     set x {}
  835.     lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
  836.     .l2 insert 0 "much longer entry"
  837.     lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
  838. } {80 93 122 110}
  839.  
  840. test listbox-7.1 {DeleteEls procedure} {
  841.     .l delete 0 end
  842.     .l insert 0 a b c d e f g h i j
  843.     .l selection set 1 6
  844.     .l delete 4 3
  845.     list [.l size] [selection get]
  846. } {10 {b
  847. c
  848. d
  849. e
  850. f
  851. g}}
  852. test listbox-7.2 {DeleteEls procedure} {
  853.     .l delete 0 end
  854.     .l insert 0 a b c d e f g h i j
  855.     .l selection set 3 6
  856.     .l delete 4 4
  857.     list [.l size] [.l get 4] [.l curselection]
  858. } {9 f {3 4 5}}
  859. test listbox-7.3 {DeleteEls procedure} {
  860.     .l delete 0 end
  861.     .l insert 0 a b c d e f g h i j
  862.     .l delete 0 3
  863.     list [.l size] [.l get 0] [.l get 1]
  864. } {6 e f}
  865. test listbox-7.4 {DeleteEls procedure} {
  866.     .l delete 0 end
  867.     .l insert 0 a b c d e f g h i j
  868.     .l delete 8 1000
  869.     list [.l size] [.l get 7]
  870. } {8 h}
  871. test listbox-7.5 {DeleteEls procedure} {
  872.     .l delete 0 end
  873.     .l insert 0 a b c d e f g h i j
  874.     .l selection anchor 2
  875.     .l delete 0 1
  876.     .l index anchor
  877. } {0}
  878. test listbox-7.6 {DeleteEls procedure} {
  879.     .l delete 0 end
  880.     .l insert 0 a b c d e f g h i j
  881.     .l selection anchor 2
  882.     .l delete 2
  883.     .l index anchor
  884. } {2}
  885. test listbox-7.7 {DeleteEls procedure} {
  886.     .l delete 0 end
  887.     .l insert 0 a b c d e f g h i j
  888.     .l selection anchor 4
  889.     .l delete 2 5
  890.     .l index anchor
  891. } {2}
  892. test listbox-7.8 {DeleteEls procedure} {
  893.     .l delete 0 end
  894.     .l insert 0 a b c d e f g h i j
  895.     .l selection anchor 3
  896.     .l delete 4 5
  897.     .l index anchor
  898. } {3}
  899. test listbox-7.9 {DeleteEls procedure} {
  900.     .l delete 0 end
  901.     .l insert 0 a b c d e f g h i j
  902.     .l yview 3
  903.     update
  904.     .l delete 1 2
  905.     .l index @0,0
  906. } {1}
  907. test listbox-7.10 {DeleteEls procedure} {
  908.     .l delete 0 end
  909.     .l insert 0 a b c d e f g h i j
  910.     .l yview 3
  911.     update
  912.     .l delete 3 4
  913.     .l index @0,0
  914. } {3}
  915. test listbox-7.11 {DeleteEls procedure} {
  916.     .l delete 0 end
  917.     .l insert 0 a b c d e f g h i j
  918.     .l yview 3
  919.     update
  920.     .l delete 4 6
  921.     .l index @0,0
  922. } {3}
  923. test listbox-7.12 {DeleteEls procedure} {
  924.     .l delete 0 end
  925.     .l insert 0 a b c d e f g h i j
  926.     .l yview 3
  927.     update
  928.     .l delete 3 end
  929.     .l index @0,0
  930. } {1}
  931. test listbox-7.13 {DeleteEls procedure, updating view with partial last line} {
  932.     mkPartial
  933.     .partial.l yview 8
  934.     update
  935.     .partial.l delete 10 13
  936.     .partial.l index @0,0
  937. } {7}
  938. test listbox-7.14 {DeleteEls procedure} {
  939.     .l delete 0 end
  940.     .l insert 0 a b c d e f g h i j
  941.     .l activate 6
  942.     .l delete 3 4
  943.     .l index active
  944. } {4}
  945. test listbox-7.15 {DeleteEls procedure} {
  946.     .l delete 0 end
  947.     .l insert 0 a b c d e f g h i j
  948.     .l activate 6
  949.     .l delete 5 7
  950.     .l index active
  951. } {5}
  952. test listbox-7.16 {DeleteEls procedure} {
  953.     .l delete 0 end
  954.     .l insert 0 a b c d e f g h i j
  955.     .l activate 6
  956.     .l delete 5 end
  957.     .l index active
  958. } {4}
  959. test listbox-7.17 {DeleteEls procedure} {
  960.     .l delete 0 end
  961.     .l insert 0 a b c d e f g h i j
  962.     .l activate 6
  963.     .l delete 0 end
  964.     .l index active
  965. } {0}
  966. test listbox-7.18 {DeleteEls procedure} {
  967.     .l delete 0 end
  968.     .l insert 0 a b c "two words" d e f g h i j
  969.     update
  970.     set log {}
  971.     .l delete 4 6
  972.     update
  973.     set log
  974. } {{y 0 0.25}}
  975. test listbox-7.19 {DeleteEls procedure} {
  976.     .l delete 0 end
  977.     .l insert 0 a b c "two words" d e f g h i j
  978.     update
  979.     set log {}
  980.     .l delete 3
  981.     update
  982.     set log
  983. } {{y 0 0.2} {x 0 1}}
  984. test listbox-7.20 {DeleteEls procedure} {fonts} {
  985.     catch {destroy .l2}
  986.     listbox .l2 -width 0 -height 0
  987.     pack .l2 -side top
  988.     .l2 insert 0 a b "two words" c d e f g
  989.     set x {}
  990.     lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
  991.     .l2 delete 2 4
  992.     lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
  993. } {80 144 17 93}
  994. catch {destroy .l2}
  995.  
  996. test listbox-8.1 {ListboxEventProc procedure} {fonts} {
  997.     catch {destroy .l}
  998.     listbox .l -setgrid 1
  999.     pack .l
  1000.     update
  1001.     set x [getsize .]
  1002.     destroy .l
  1003.     list $x [getsize .] [winfo exists .l] [info command .l]
  1004. } {20x10 150x178 0 {}}
  1005. resetGridInfo
  1006. test listbox-8.2 {ListboxEventProc procedure} {fonts} {
  1007.     catch {destroy .l}
  1008.     listbox .l -height 5 -width 10
  1009.     .l insert 0 a b c "A string that is very very long" d e f g h i j k
  1010.     pack .l
  1011.     update
  1012.     place .l -width 50 -height 80
  1013.     update
  1014.     list [.l xview] [.l yview]
  1015. } {{0 0.222222} {0 0.333333}}
  1016. test listbox-8.3 {ListboxEventProc procedure} {
  1017.     eval destroy [winfo children .]
  1018.     listbox .l1 -bg #543210
  1019.     rename .l1 .l2
  1020.     set x {}
  1021.     lappend x [winfo children .]
  1022.     lappend x [.l2 cget -bg]
  1023.     destroy .l1
  1024.     lappend x [info command .l*] [winfo children .]
  1025. } {.l1 #543210 {} {}}
  1026.  
  1027. test listbox-9.1 {ListboxCmdDeletedProc procedure} {
  1028.     eval destroy [winfo children .]
  1029.     listbox .l1
  1030.     rename .l1 {}
  1031.     list [info command .l*] [winfo children .]
  1032. } {{} {}}
  1033. test listbox-9.2 {ListboxCmdDeletedProc procedure, disabling -setgrid} fonts {
  1034.     catch {destroy .top}
  1035.     toplevel .top
  1036.     wm geom .top +0+0
  1037.     listbox .top.l -setgrid 1 -width 20 -height 10
  1038.     pack .top.l
  1039.     update
  1040.     set x [wm geometry .top]
  1041.     rename .top.l {}
  1042.     update
  1043.     lappend x [wm geometry .top]
  1044.     destroy .top
  1045.     set x
  1046. } {20x10+0+0 150x178+0+0}
  1047.  
  1048. catch {destroy .l}
  1049. listbox .l
  1050. pack .l
  1051. .l delete 0 end
  1052. .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
  1053. test listbox-10.1 {GetListboxIndex procedure} {
  1054.     .l activate 3
  1055.     list [.l activate 3; .l index active] [.l activate 6; .l index active]
  1056. } {3 6}
  1057. test listbox-10.2 {GetListboxIndex procedure} {
  1058.     .l selection anchor 2
  1059.     .l index anchor
  1060. } 2
  1061. test listbox-10.3 {GetListboxIndex procedure} {
  1062.     .l insert end A B C D E
  1063.     .l selection anchor end
  1064.     .l delete 12 end
  1065.     list [.l index anchor] [.l index end]
  1066. } {12 12}
  1067. test listbox-10.4 {GetListboxIndex procedure} {
  1068.     list [catch {.l index a} msg] $msg
  1069. } {1 {bad listbox index "a": must be active, anchor, end, @x,y, or a number}}
  1070. test listbox-10.5 {GetListboxIndex procedure} {
  1071.     .l index end
  1072. } {12}
  1073. test listbox-10.6 {GetListboxIndex procedure} {
  1074.     .l get end
  1075. } {el11}
  1076. test listbox-10.7 {GetListboxIndex procedure} {
  1077.     .l delete 0 end
  1078.     .l index end
  1079. } 0
  1080. .l delete 0 end
  1081. .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
  1082. update
  1083. test listbox-10.8 {GetListboxIndex procedure} {
  1084.     list [catch {.l index @} msg] $msg
  1085. } {1 {bad listbox index "@": must be active, anchor, end, @x,y, or a number}}
  1086. test listbox-10.9 {GetListboxIndex procedure} {
  1087.     list [catch {.l index @foo} msg] $msg
  1088. } {1 {bad listbox index "@foo": must be active, anchor, end, @x,y, or a number}}
  1089. test listbox-10.10 {GetListboxIndex procedure} {
  1090.     list [catch {.l index @1x3} msg] $msg
  1091. } {1 {bad listbox index "@1x3": must be active, anchor, end, @x,y, or a number}}
  1092. test listbox-10.11 {GetListboxIndex procedure} {
  1093.     list [catch {.l index @1,} msg] $msg
  1094. } {1 {bad listbox index "@1,": must be active, anchor, end, @x,y, or a number}}
  1095. test listbox-10.12 {GetListboxIndex procedure} {
  1096.     list [catch {.l index @1,foo} msg] $msg
  1097. } {1 {bad listbox index "@1,foo": must be active, anchor, end, @x,y, or a number}}
  1098. test listbox-10.13 {GetListboxIndex procedure} {
  1099.     list [catch {.l index @1,2x} msg] $msg
  1100. } {1 {bad listbox index "@1,2x": must be active, anchor, end, @x,y, or a number}}
  1101. test listbox-10.14 {GetListboxIndex procedure} {fonts} {
  1102.     list [.l index @5,57] [.l index @5,58]
  1103. } {3 3}
  1104. test listbox-10.15 {GetListboxIndex procedure} {
  1105.     list [catch {.l index 1xy} msg] $msg
  1106. } {1 {bad listbox index "1xy": must be active, anchor, end, @x,y, or a number}}
  1107. test listbox-10.16 {GetListboxIndex procedure} {
  1108.     .l index 3
  1109. } {3}
  1110. test listbox-10.17 {GetListboxIndex procedure} {
  1111.     .l index 20
  1112. } {12}
  1113. test listbox-10.18 {GetListboxIndex procedure} {
  1114.     .l get 20
  1115. } {el11}
  1116. test listbox-10.19 {GetListboxIndex procedure} {
  1117.     .l index -2
  1118. } 0
  1119. test listbox-10.20 {GetListboxIndex procedure} {
  1120.     .l delete 0 end
  1121.     .l index 1
  1122. } 0
  1123.  
  1124. test listbox-11.1 {ChangeListboxView procedure} {
  1125.     catch {destroy .l}
  1126.     listbox .l -height 5 -yscrollcommand "record y"
  1127.     pack .l
  1128.     .l insert 0 a b c d e f g h i j
  1129.     update
  1130.     set log {}
  1131.     .l yview 2
  1132.     update
  1133.     list [.l yview] $log
  1134. }  {{0.2 0.7} {{y 0.2 0.7}}}
  1135. test listbox-11.2 {ChangeListboxView procedure} {
  1136.     catch {destroy .l}
  1137.     listbox .l -height 5 -yscrollcommand "record y"
  1138.     pack .l
  1139.     .l insert 0 a b c d e f g h i j
  1140.     update
  1141.     set log {}
  1142.     .l yview 8
  1143.     update
  1144.     list [.l yview] $log
  1145. }  {{0.5 1} {{y 0.5 1}}}
  1146. test listbox-11.3 {ChangeListboxView procedure} {
  1147.     catch {destroy .l}
  1148.     listbox .l -height 5 -yscrollcommand "record y"
  1149.     pack .l
  1150.     .l insert 0 a b c d e f g h i j
  1151.     .l yview 3
  1152.     update
  1153.     set log {}
  1154.     .l yview 3
  1155.     update
  1156.     list [.l yview] $log
  1157. }  {{0.3 0.8} {}}
  1158. test listbox-11.4 {ChangeListboxView procedure, partial last line} {
  1159.     mkPartial
  1160.     .partial.l yview 13
  1161.     .partial.l index @0,0
  1162. } {11}
  1163.  
  1164. catch {destroy .l}
  1165. listbox .l -font $fixed -xscrollcommand "record x" -width 10
  1166. .l insert 0 0123456789a123456789b123456789c123456789d123456789e123456789f123456789g123456789h123456789i123456789
  1167. pack .l
  1168. update
  1169. test listbox-12.1 {ChangeListboxOffset procedure} {fonts} {
  1170.     set log {}
  1171.     .l xview 99
  1172.     update
  1173.     list [.l xview] $log
  1174. } {{0.89 0.99} {{x 0.89 0.99}}}
  1175. test listbox-12.2 {ChangeListboxOffset procedure} {fonts} {
  1176.     set log {}
  1177.     .l xview moveto -.25
  1178.     update
  1179.     list [.l xview] $log
  1180. } {{0 0.1} {{x 0 0.1}}}
  1181. test listbox-12.3 {ChangeListboxOffset procedure} {fonts} {
  1182.     .l xview 10
  1183.     update
  1184.     set log {}
  1185.     .l xview 10
  1186.     update
  1187.     list [.l xview] $log
  1188. } {{0.1 0.2} {}}
  1189.  
  1190. catch {destroy .l}
  1191. listbox .l -font $fixed -width 10 -height 5
  1192. pack .l
  1193. .l insert 0 a bb c d e f g h i j k l m n o p q r s
  1194. .l insert 0 0123456789a123456789b123456789c123456789d123456789
  1195. update
  1196. set width [expr [lindex [.l bbox 2] 2] - [lindex [.l bbox 1] 2]]
  1197. set height [expr [lindex [.l bbox 2] 1] - [lindex [.l bbox 1] 1]]
  1198. test listbox-13.1 {ListboxScanTo procedure} {fonts} {
  1199.     .l yview 0
  1200.     .l xview 0
  1201.     .l scan mark 10 20
  1202.     .l scan dragto [expr 10-$width] [expr 20-$height]
  1203.     update
  1204.     list [.l xview] [.l yview]
  1205. } {{0.2 0.4} {0.5 0.75}}
  1206. test listbox-13.2 {ListboxScanTo procedure} {fonts} {
  1207.     .l yview 5
  1208.     .l xview 10
  1209.     .l scan mark 10 20
  1210.     .l scan dragto 20 40
  1211.     update
  1212.     set x [list [.l xview] [.l yview]]
  1213.     .l scan dragto [expr 20-$width] [expr 40-$height]
  1214.     update
  1215.     lappend x [.l xview] [.l yview]
  1216. } {{0 0.2} {0 0.25} {0.2 0.4} {0.5 0.75}}
  1217. test listbox-13.3 {ListboxScanTo procedure} {fonts} {
  1218.     .l yview moveto 1.0
  1219.     .l xview moveto 1.0
  1220.     .l scan mark 10 20
  1221.     .l scan dragto 5 10
  1222.     update
  1223.     set x [list [.l xview] [.l yview]]
  1224.     .l scan dragto [expr 5+$width] [expr 10+$height]
  1225.     update
  1226.     lappend x [.l xview] [.l yview]
  1227. } {{0.78 0.98} {0.75 1} {0.62 0.82} {0.25 0.5}}
  1228.  
  1229. test listbox-14.1 {NearestListboxElement procedure, partial last line} {
  1230.     mkPartial
  1231.     .partial.l nearest [winfo height .partial.l]
  1232. } {4}
  1233. catch {destroy .l}
  1234. listbox .l -font $fixed -width 20 -height 10
  1235. .l insert 0 a b c d e f g h i j k l m n o p q r s t
  1236. .l yview 4
  1237. pack .l
  1238. update
  1239. test listbox-14.2 {NearestListboxElement procedure} {fonts} {
  1240.     .l index @50,0
  1241. } {4}
  1242. test listbox-14.3 {NearestListboxElement procedure} {fonts} {
  1243.     list [.l index @50,35] [.l index @50,36]
  1244. } {5 6}
  1245. test listbox-14.4 {NearestListboxElement procedure} {fonts} {
  1246.     .l index @50,200
  1247. } {13}
  1248.  
  1249. test listbox-15.1 {ListboxSelect procedure} {
  1250.     .l delete 0 end
  1251.     .l insert 0 a b c d e f g h i j k l m n o p
  1252.     .l select set 2 4
  1253.     .l select set 7 12
  1254.     .l select clear 4 7
  1255.     .l curselection
  1256. } {2 3 8 9 10 11 12}
  1257. test listbox-15.2 {ListboxSelect procedure} {
  1258.     .l delete 0 end
  1259.     .l insert 0 a b c d e f g h i j k l m n o p
  1260.     catch {destroy .e}
  1261.     entry .e
  1262.     .e insert 0 "This is some text"
  1263.     .e select from 0
  1264.     .e select to 7
  1265.     .l selection clear 2 4
  1266.     set x [selection own]
  1267.     .l selection set 3
  1268.     list $x [selection own] [selection get]
  1269. } {.e .l d}
  1270. test listbox-15.3 {ListboxSelect procedure} {
  1271.     .l delete 0 end
  1272.     .l selection clear 0 end
  1273.     .l select set 0 end
  1274.     .l curselection
  1275. } {}
  1276.  
  1277. test listbox-16.1 {ListboxFetchSelection procedure} {
  1278.     .l delete 0 end
  1279.     .l insert 0 a b c "two words" e f g h i \\ k l m n o p
  1280.     .l selection set 2 4
  1281.     .l selection set 9
  1282.     .l selection set 11 12
  1283.     selection get
  1284. } "c\ntwo words\ne\n\\\nl\nm"
  1285. test listbox-16.2 {ListboxFetchSelection procedure} {
  1286.     .l delete 0 end
  1287.     .l insert 0 a b c "two words" e f g h i \\ k l m n o p
  1288.     .l selection set 3
  1289.     selection get
  1290. } "two words"
  1291. test listbox-16.3 {ListboxFetchSelection procedure, retrieve in several parts} {
  1292.     set long "This is quite a long string\n"
  1293.     append long $long $long $long $long
  1294.     append long $long $long $long $long
  1295.     append long $long $long
  1296.     .l delete 0 end
  1297.     .l insert 0 1$long 2$long 3$long 4$long 5$long
  1298.     .l selection set 0 end
  1299.     set sel [selection get]
  1300.     string compare 1$long\n2$long\n3$long\n4$long\n5$long $sel
  1301. } {0}
  1302. catch {unset long sel}
  1303.  
  1304. test listbox-17.1 {ListboxLostSelection procedure} {
  1305.     .l delete 0 end
  1306.     .l insert 0 a b c d e
  1307.     .l select set 0 end
  1308.     catch {destroy .e}
  1309.     entry .e
  1310.     .e insert 0 "This is some text"
  1311.     .e select from 0
  1312.     .e select to 5
  1313.     .l curselection
  1314. } {}
  1315. test listbox-17.2 {ListboxLostSelection procedure} {
  1316.     .l delete 0 end
  1317.     .l insert 0 a b c d e
  1318.     .l select set 0 end
  1319.     .l configure -exportselection 0
  1320.     catch {destroy .e}
  1321.     entry .e
  1322.     .e insert 0 "This is some text"
  1323.     .e select from 0
  1324.     .e select to 5
  1325.     .l curselection
  1326. } {0 1 2 3 4}
  1327.  
  1328. catch {destroy .l}
  1329. listbox .l -font $fixed -width 10 -height 5
  1330. pack .l
  1331. update
  1332. test listbox-18.1 {ListboxUpdateVScrollbar procedure} {
  1333.     .l configure -yscrollcommand "record y"
  1334.     set log {}
  1335.     .l insert 0 a b c
  1336.     update
  1337.     .l insert end d e f g h
  1338.     update
  1339.     .l delete 0 end
  1340.     update
  1341.     set log
  1342. } {{y 0 1} {y 0 0.625} {y 0 1}}
  1343. test listbox-18.2 {ListboxUpdateVScrollbar procedure, partial last line} {
  1344.     mkPartial
  1345.     .partial.l configure -yscrollcommand "record y"
  1346.     set log {}
  1347.     .partial.l yview 3
  1348.     update
  1349.     set log
  1350. } {{y 0.2 0.466667}}
  1351. test listbox-18.3 {ListboxUpdateVScrollbar procedure} {
  1352.     proc bgerror args {
  1353.     global x errorInfo
  1354.     set x [list $args $errorInfo]
  1355.     }
  1356.     .l configure -yscrollcommand gorp
  1357.     .l insert 0 foo
  1358.     update
  1359.     set x
  1360. } {{{invalid command name "gorp"}} {invalid command name "gorp"
  1361.     while executing
  1362. "gorp 0 1"
  1363.     (vertical scrolling command executed by listbox)}}
  1364. if {[info exists bgerror]} {
  1365.     rename bgerror {}
  1366. }
  1367.  
  1368. catch {destroy .l}
  1369. listbox .l -font $fixed -width 10 -height 5
  1370. pack .l
  1371. update
  1372. test listbox-19.1 {ListboxUpdateVScrollbar procedure} {fonts} {
  1373.     .l configure -xscrollcommand "record x"
  1374.     set log {}
  1375.     .l insert 0 abc
  1376.     update
  1377.     .l insert 0 "This is a much longer string..."
  1378.     update
  1379.     .l delete 0 end
  1380.     update
  1381.     set log
  1382. } {{x 0 1} {x 0 0.322581} {x 0 1}}
  1383. test listbox-19.2 {ListboxUpdateVScrollbar procedure} {
  1384.     proc bgerror args {
  1385.     global x errorInfo
  1386.     set x [list $args $errorInfo]
  1387.     }
  1388.     .l configure -xscrollcommand bogus
  1389.     .l insert 0 foo
  1390.     update
  1391.     set x
  1392. } {{{invalid command name "bogus"}} {invalid command name "bogus"
  1393.     while executing
  1394. "bogus 0 1"
  1395.     (horizontal scrolling command executed by listbox)}}
  1396.  
  1397. set l [interp hidden]
  1398. eval destroy [winfo children .]
  1399.  
  1400. test listbox-20.1 {listbox vs hidden commands} {
  1401.     catch {destroy .l}
  1402.     listbox .l
  1403.     interp hide {} .l
  1404.     destroy .l
  1405.     list [winfo children .] [interp hidden]
  1406. } [list {} $l]
  1407.  
  1408. resetGridInfo
  1409. catch {destroy .l2}
  1410. catch {destroy .t}
  1411. catch {destroy .e}
  1412. catch {destroy .partial}
  1413. option clear
  1414.  
  1415.